home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / hypercar / xfcn / spttool.cpt / Support Tools eXternals 1.2.5 / card_12806.txt < prev    next >
Text File  |  1990-11-13  |  9KB  |  293 lines
  1. -- card: 12806 from stack: in.5
  2. -- bmap block id: 16987
  3. -- flags: 0000
  4. -- background id: 3858
  5. -- name: System Path
  6. ----- HyperTalk script -----
  7. on HideObjects
  8.   hide cd btn "try it!"
  9. end HideObjects
  10.  
  11. on ShowObjects
  12.   show cd btn "try it!"
  13. end ShowObjects
  14.  
  15.  
  16. -- part 1 (button)
  17. -- low flags: 00
  18. -- high flags: A002
  19. -- rect: left=82 top=185 right=219 bottom=175
  20. -- title width / last selected line: 0
  21. -- icon id / first selected line: 0 / 0
  22. -- text alignment: 1
  23. -- font id: 0
  24. -- text size: 12
  25. -- style flags: 8192
  26. -- line height: 16
  27. -- part name: Try it!
  28. ----- HyperTalk script -----
  29. on mouseUp
  30.   global errGlobal
  31.   answer "The path to your system folder is ΓÇ£" & SystemPath("noDialog:errGlobal") & "ΓÇ¥."
  32. end mouseUp
  33.  
  34.  
  35.  
  36.  
  37. -- part contents for background part 38
  38. ----- text -----
  39. 45/50
  40.  
  41. -- part contents for background part 42
  42. ----- text -----
  43. { SystemPath(ΓÇ£noDialog:ΓÇ¥errorGlobal)          }
  44. { XFCN to return the path to the currently active system folder}
  45. {}
  46. {}
  47. {  brought to you by:  Anup Murarka      Eric Carlson    }
  48. {            ALINK:  SKEPTIC      ALINK:  cyNic  }
  49. {                  CIS:  76004,3356    }
  50. {}
  51. {        We are part of the Support Tools Development Group,  }
  52. {        Apple Computer, Inc.  }
  53. {}
  54. {        please DO NOT contack Mac DTS for support of this code!  }
  55. {}
  56. {        please DO contact the authors for support of this code!  }
  57. {}
  58. {        Send comments, bug reports, requests to any of the above  }
  59. {        E-mail addresses or to:}
  60. {}
  61. {              (one of us)          }
  62. {              Apple Computer, Inc.    }
  63. {              900 E. Hamilton, Ave.    }
  64. {              Campbell, CA   95008    }
  65. {              M/S 72-L          }
  66. {}
  67. {  Copyright:  ┬⌐ 1989, 1990 by Apple Computer, Inc., all rights reserved.  }
  68. {}
  69. { written by Eric Carlson                    }
  70. { AppleLink:  cyNic                        }
  71. { modification history                                             }
  72. {       Date        Initials                  Comments                }
  73. {       ----        ------    ------------------------------------------------------}
  74. {    3/8/90        ec      first written                                }
  75. {    6/2/90        ec      modified for A/UX 2.0 compatibility  (recompiled with new     }
  76. {                                  library routines)                          }
  77. {}
  78.  
  79. unit SystemPath;
  80.  
  81. interface
  82.  
  83.   uses
  84.     HyperXCmd;
  85.  
  86.   procedure MAIN (paramPtr: XCmdPtr);
  87.  
  88. implementation
  89.  
  90.   procedure reportToUser (paramPtr: XCmdPtr;
  91.                   msgStr: str255);
  92. {}
  93. { report something back to the user.  }
  94. { the last parameter (optional) to an external may contain }
  95.  { "noDialog" or "noDialog:GlobalName".  GlobalName is the name }
  96.  { of a HyperTalk global variable into which error messages will be }
  97.  { placed.  we've decided to use this approach to avoid confusing }
  98. { an error message with a valid result being returned from an XFCN. }
  99. {}
  100.     var
  101.       tempStr: str255;
  102.   begin
  103. {check the last param to see if the user requested that}
  104. { we suppress the error dialog }
  105.     ZeroToPas(paramPtr, paramPtr^.params[paramPtr^.paramCount]^, tempStr);
  106.     UprString(tempStr, true);
  107.     if pos('NODIALOG', tempStr) = 0 then
  108.   { no special error handling specified, throw up a dialog and return the error message }
  109.       begin
  110.         SendCardMessage(paramPtr, concat('answer "', msgStr, '"'));
  111.         paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
  112.       end
  113.     else if (pos(':', tempStr) > 0) then
  114.   { requested global AND noDialog so we fill in the global and return empty }
  115.       begin
  116.         tempStr := copy(tempStr, pos(':', tempStr) + 1, length(tempStr));
  117.                             { get the name of the HC global  to fill }
  118.         SetGlobal(paramPtr, tempStr, PasToZero(paramPtr, msgStr));
  119.                             { and fill it }
  120.         paramPtr^.returnValue := PasToZero(paramPtr, '');  { return empty }
  121.       end
  122.     else
  123.   { requested noDialog only so we return the error condition as the result }
  124.       paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
  125.   end;  { procedure }
  126.  
  127.   function askedForHelp (paramPtr: XCmdPtr;
  128.                   syntaxMsg: Str255;
  129.                   copyRightMsg: Str255): boolean;
  130. {  check to see if the user sent a '?' or a '!' as }
  131. { the only parameter. if so we will respond with }
  132. { the calling syntax or the copyright/version info }
  133. { for this external }
  134. {}
  135.     var
  136.       firstStr: str255;
  137.   begin
  138.     askedForHelp := false;
  139.     if paramPtr^.paramCount = 1 then
  140.       begin
  141.         ZeroToPas(paramPtr, paramPtr^.params[1]^, firstStr);
  142.           { what is the first param? }
  143.         if firstStr = '?' then
  144.           begin
  145.             reportToUser(paramPtr, syntaxMsg);
  146.             askedForHelp := true
  147.           end  { asked for help }
  148.         else if firstStr = '!' then
  149.           begin
  150.             reportToUser(paramPtr, copyRightMsg);
  151.             askedForHelp := true
  152.           end;  { asked for copyright info }
  153.       end;  { one parameter passed }
  154.   end;  { function }
  155.  
  156.   function NumberToString (paramPtr: XCmdPtr;
  157.                   num: LONGINT): Str255;
  158. { use the toolbox call rather than HC's }
  159.     var
  160.       tempStr: str255;
  161.   begin
  162.     NumToString(num, tempStr);
  163.     NumberToString := tempStr;
  164.   end;
  165.  
  166.   procedure ReportVolError (paramPtr: XCmdPtr;
  167.                   errorNum: integer);
  168.     var
  169.       errMsg, tempName: str255;
  170.   begin
  171.     sysbeep(40);
  172.     case errorNum of          { what caused the problem? }
  173.       bdNamErr: 
  174.         errMsg := 'Bad volume name.';
  175.       extFSErr: 
  176.         errMsg := 'External file system.';
  177.       ioErr: 
  178.         errMsg := 'I/O Error.';
  179.       nsDrvErr: 
  180.         errMsg := 'No such drive.';
  181.       nsvErr: 
  182.         errMsg := 'No such volume.';
  183.       paramErr: 
  184.         errMsg := 'No default volume.';
  185.       otherwise
  186.         errMsg := concat('unexpected error #', NumberToString(paramPtr, errorNum));
  187.     end;    { case }
  188.  
  189.     errMsg := concat('Sorry, ', errMsg);
  190.     reportToUser(paramPtr, errMsg);
  191.     { return the error message }
  192.   end;    { function }
  193.  
  194.   function PathNameFromDirID (dirID: longint;
  195.                   vRefnum: integer;
  196.                   var fullPathName: str255): OSErr;
  197. { build up a full path name given a directory id and an vol ref num.  this method isn't reccomended in general (see the }
  198. {  various tech notes, but we use it in HC externals as HC uses exclusively full path names }
  199.     var
  200.       myCPB: CInfoPBRec;
  201.       directoryName: str255;
  202.       err: OSErr;
  203.   begin
  204.     fullPathName := '';
  205.     with myCPB do
  206.       begin
  207.         ioNamePtr := @directoryName;
  208.         ioDrParID := DirId;
  209.       end;
  210.  
  211.     repeat
  212.       with myCPB do
  213.         begin
  214.           ioVRefNum := vRefNum;
  215.           ioFDirIndex := -1;
  216.           ioDrDirID := myCPB.ioDrParID;
  217.         end;
  218.       err := PBGetCatInfo(@myCPB, FALSE);
  219.  
  220.       directoryName := concat(directoryName, ':');
  221.  
  222. { pascal strings mustn't be longer than 255 chars, though a path name may, so check }
  223.       if length(directoryName) + length(fullPathName) <= 255 then
  224.         fullPathName := concat(directoryName, fullPathName)
  225.       else
  226.         myCPB.ioDrDirID := fsRtDirID;    { lazy persons way to jump out }
  227.  
  228.     until (myCPB.ioDrDirID = 2);
  229.     PathNameFromDirID := err;
  230.   end;
  231.  
  232.   procedure SystemPath (paramPtr: XCmdPtr);
  233.     var
  234.       pathName: str255;
  235.       PB: HParamBlockRec;
  236.       errorCode: OSerr;
  237.       sysRec: SysEnvRec;
  238.       systemVRefNum: longint;
  239.  
  240.   begin  { SystemPath}
  241.     if AskedForHelp(paramPtr, 'SystemPath(ΓÇ£noDialog:ΓÇ¥errorGlobal)', '┬⌐ 1989, 1990 by Apple Computer, Inc., v.1.1,  by Eric Carlson.') then
  242.       exit(SystemPath);
  243.  
  244.  
  245.     errorCode := SysEnvirons(2, sysRec);        { Get the vrefnum of the directory containing the open System file }
  246.     if errorCode <> noErr then              { we will use this in our PBHGetVInfo }
  247.       begin
  248.         ReportToUser(paramPtr, 'Unexpected SysEnvirons error.');
  249.         exit(SystemPath);
  250.       end;
  251.     systemVRefNum := sysRec.sysVRefNum;
  252.  
  253.  
  254.  
  255.     zeroBytes(paramPtr, @PB, sizeOf(PB));      { initialize the parameter block with zeros in all fields.}
  256.     with PB do                        { now fill in the paramBlock for our call }
  257.       begin
  258.         ioCompletion := nil;                  { don't need an async call }
  259.         ioNamePtr := nil;                  { don't know the volume's name, nor do we care }
  260.         ioVolIndex := 1;                    { we want info on the first mounted volume - the boot volume }
  261.       end;
  262.  
  263.     errorCode := PBHGetVInfo(@PB, false);        { next we need the directory id of the blessed folder - one of those  }
  264.     if errorCode <> noErr then              {  mysterious ΓÇ£Finder FlagΓÇ¥ fields on the in the param block}
  265.       begin
  266.         ReportVolError(paramPtr, errorCode);
  267.         exit(SystemPath);
  268.       end;
  269.  
  270.     errorCode := PathNameFromDirID(PB.ioVFndrInfo[1], systemVRefNum, pathName);  { and now the full path }
  271.     if errorCode <> noErr then
  272.       begin
  273.         ReportVolError(paramPtr, errorCode);
  274.         exit(SystemPath);
  275.       end;
  276.  
  277.     paramPtr^.returnValue := PasToZero(paramPtr, pathName);
  278.   end;
  279.  
  280.   procedure MAIN (paramPtr: XCmdPtr);
  281.   begin
  282.     SystemPath(paramPtr);
  283.   end;
  284.  
  285. end.
  286.  
  287. -- part contents for background part 20
  288. ----- text -----
  289.      Returns the path to the currently active System folder.  Useful if you need to find or leave a preferences file, or whatever.
  290.  
  291.  
  292.      Calling Syntax: SystemPath(ΓÇ£noDialog:ΓÇ¥errorGlobal)
  293.